home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / COMMON / TOOLS / VB / UNSUPPRT / SSAVER / SSENGINE.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1997-01-16  |  4.3 KB  |  70 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ssEngine"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. '-----------------------------------------------------------------
  13. Public Function CreateSprite(Display As Form, hDisplay As Long, _
  14.                              ResID As Long, MaskCol As Long, picCount As Long, _
  15.                              xUnits As Long, yUnits As Long, _
  16.                              Optional ScaleW As Single, _
  17.                              Optional ScaleH As Single, _
  18.                              Optional Idx As Long) As ssSprite
  19. '-----------------------------------------------------------------
  20.     Dim cSprite As ssSprite                         ' ScreenSaver sprite
  21.     Dim RatioX As Single, RatioY As Single          ' X and Y shrinkage factors
  22. '-----------------------------------------------------------------
  23.     Randomize Timer                                 ' Set the randomization seed
  24.     RatioX = 1                                      ' Set the x ratio base
  25.     RatioY = 1                                      ' Set the y ratio base
  26.     Display.ScaleMode = vbPixels                    ' Set the display form scalemode to pixels
  27.     
  28.     Set cSprite = New ssSprite                      ' Create a new screen saver sprite
  29.     With cSprite
  30.         .DestHDC = Display.hdc                      ' Set the display hdc
  31.         .ScreenW = (Screen.Width \ Screen.TwipsPerPixelX)  ' Calculate the screen width in pixels
  32.         .ScreenH = (Screen.Height \ Screen.TwipsPerPixelY) ' Calculate the screen height in pixels
  33.  
  34.         If (gSprite.ResID <> ResID) Then            ' Only load resource if it isn't already loaded
  35.             gSprite.ResID = ResID                   ' Save resource id
  36.             Set gSprite.Sprite = LoadResPicture(ResID, vbResBitmap) ' Load and save resource bitmap
  37.         End If
  38.         
  39.         If (.ScreenW <> 0) Then RatioX = (DispRec.Right - DispRec.Left) / .ScreenW ' Scale x ratio based on display size
  40.         If (.ScreenH <> 0) Then RatioY = (DispRec.Bottom - DispRec.Top) / .ScreenH ' Scale y ratio based on display size
  41.         If (ScaleW = 0) Then ScaleW = 1             ' Fix scale width
  42.         If (ScaleH = 0) Then ScaleH = 1             ' Fix scale height
  43.         RatioX = RatioX * ScaleW                    ' Adjust X ratio based on sprite scale width
  44.         RatioY = RatioY * ScaleH                    ' Adjust Y ratio based on sprite scale height
  45.         
  46.         .hBitmap = ShrinkBmp(.DestHDC, gSprite.Sprite.Handle, RatioX, RatioY) ' Shrink animated sprite frames...
  47.         
  48.         .SprtW = CLng(Display.ScaleX(gSprite.Sprite.Width, vbHimetric, vbPixels) * RatioX)  ' Calc scaled source image width
  49.         .SprtH = CLng(Display.ScaleY(gSprite.Sprite.Height, vbHimetric, vbPixels) * RatioY) ' Calc scaled source image height
  50.         
  51.         .xUnits = xUnits                            ' Save # of horizontal frames
  52.         .yUnits = yUnits                            ' Save # of verticle frames
  53.         .uWidth = .SprtW \ xUnits                   ' calculate single frame width
  54.         .uHeight = .SprtH \ yUnits                  ' calculate single frame height
  55.         .idxMin = 0                                 ' initialize frame index = 0
  56.         .idxMax = picCount - 1                      ' init max frame index = # frames - 1
  57.         .bmpIdx = (.idxMax - .idxMin) * Rnd + .idxMin ' randomize the first picture frame to be displayed
  58.         .hDisplayBack = hDisplay                    ' save handle to the display bitmap...
  59.         .MASKCOLOR = MaskCol                        ' save the bitmap mask color...
  60.         .Mass = CLng(BASE_MASS * ScaleW * ScaleH)   ' calculate mass based on scaled surface area
  61.         .Index = Idx                                ' save index possition in global array...
  62. '''        gSpriteCollection.Add cSprite               ' add sprite to global collection...
  63.     End With
  64.     
  65.     Set CreateSprite = cSprite                      ' return sprite reference...
  66.     Set cSprite = Nothing                           ' destroy local sprite reference...
  67. '-----------------------------------------------------------------
  68. End Function
  69. '-----------------------------------------------------------------
  70.